home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / STRAOB / MISCOTHR.INC < prev    next >
Text File  |  1994-12-21  |  6KB  |  210 lines
  1.  
  2. {SECTION  Execute }
  3. Function  Execute(exefilename,params : string) : integer;
  4.                         {[EXEC] run DOS program from program }
  5. var err            : integer;
  6.      begin
  7.      err := 999;
  8.      if FileExistsMSG(exefilename,'','Unable to find EXE file.') then
  9.           begin
  10.           {writeln('Execing [',CommandComFile,'] [',cmd,']');}
  11.           SwapVectors;
  12.           Exec(exefilename,params);
  13.           SwapVectors;
  14.           err := DOSError;
  15.           if err = 8 then writeln('EXEC failed 8 (MAKE YOUR HEAP SMALLER!)  err= ',err);
  16.           end;
  17.      Execute := err;
  18.      end;
  19.  
  20.  
  21. {SECTION  ExecuteCommand }
  22. Function  ExecuteCommand(cmd : string) : integer;
  23. var err            : integer;
  24.     CommandComFile : string[50];
  25.      begin
  26.      err := 0;
  27.      CommandComFile  := getenv('COMSPEC');
  28.      if FileExists(CommandComFile) then
  29.           begin
  30.           {writeln('Execing [',CommandComFile,'] [',cmd,']');}
  31.           SwapVectors;
  32.           Exec(CommandComFile,'/C ' + cmd);
  33.           SwapVectors;
  34.           err := DOSError;
  35.           if err = 8 then writeln('EXEC failed 8 (MAKE YOUR HEAP SMALLER!)  err= ',err);
  36.           end
  37.      else begin
  38.           writeln('Unable to find program ',CommandComFile);
  39.           err := 999;
  40.           end;
  41.      ExecuteCommand := err;
  42.      end;
  43.  
  44.  
  45. {SECTION TPC }
  46. Function TPC(fname,options : string; var err : integer) : boolean;
  47.             {[EXEC] - Invokes the compiler directly, finds a few errors}
  48.  
  49. { Expected errors  = -1 -> compile failed, no output file
  50.                    = 15 -> input file not found
  51. }
  52.  
  53. var ok   : boolean;
  54.     line,fn,fn1 : string;
  55.      begin
  56.      fn := fname;
  57.      ok := true;
  58.      err := 0;
  59.      line := fn + ' '+ options;
  60.      if not fileexists(fn) then
  61.           begin
  62.           err := 15;
  63.           ok := false;
  64.           end;
  65.      fn1 := fn; forceext(fn1,'tpu');
  66.      if fileexists(fn1) then erasefile(fn1)
  67.      else begin
  68.           fn1 := fn; forceext(fn1,'exe');
  69.           if fileexists(fn) then erasefile(fn1);
  70.           end;
  71.      SwapVectors;
  72.      exec('c:\bp\bin\tpc.exe',line);
  73.      SwapVectors;
  74.      if DosError <> 0 then
  75.           begin
  76.           err := DosError;
  77.           ok := false;
  78.           end
  79.      else begin
  80.           fn1 := fn; forceext(fn1,'tpu');
  81.           if fileexists(fn1) then
  82.                begin
  83.                if filedate(fn,'') > filedate(fn1,'') then
  84.                     begin
  85.                     err := -1;
  86.                     ok := false;
  87.                     end;
  88.                end
  89.           else begin
  90.                fn1 := fn; forceext(fn1,'exe');
  91.                if fileexists(fn) then
  92.                     begin
  93.                     if filedate(fn,'') > filedate(fn1,'') then
  94.                          begin
  95.                          err := -1;
  96.                          ok := false;
  97.                          end;
  98.                     end
  99.                else begin
  100.                     err := -2;
  101.                     ok := false;
  102.                     end;
  103.                end;
  104.           end;
  105.      TPC := ok;
  106.      end;
  107.  
  108. {PAGE}
  109. {section NCHANT }
  110. { Enchanted text is a mid-level encryption.  Should be enough to
  111. discourage casual hacking.  Retains CR/LF and line separation.
  112. Hides repeated characters by using a random key on each line and
  113. appending the key to the string.  Algorithm uses character position
  114. in string as a bias so the same character on a line will probably appear
  115. different.  This would not slow NSA down, but it is good enough.
  116. Comparable to GIFCRYPT palette scrambling.  A text file can be mixed clear
  117. and encrypted lines, if that is useful.
  118. Limitation - the last character of the unencrypted line can not be
  119. between  128 and 160 - very seldom used characters.}
  120.  
  121. Function RollChar(ch : char; n : integer) : char;
  122.            {[STRING] NCHANT support circular shift n places 32-127 }
  123. var x,nn : integer;
  124.     chx  : char;
  125.      begin
  126.      chx := ch;
  127.      if (ord(ch) > 31) and (ord(ch) < 128) then
  128.           begin
  129.           if (n > -95) and (n < 95) then
  130.                begin
  131.                x := ord(ch) + n;
  132.                if      x <  32 then x := x + 96
  133.                else if x > 127 then x := x - 96;
  134.                chx := chr(x);
  135.                end;
  136.           end;
  137.      RollChar := chx;
  138.      end;
  139.  
  140.  
  141. Function IsNCHANTed(st : string) : boolean;
  142.               {[STRING] Text Encryption - tests string - support for NCHANT }
  143.      begin
  144.      if (ord(st[length(st)]) > 127) and (ord(st[length(st)]) < 160) then
  145.           IsNCHANTed := true
  146.      else IsNCHANTed := false;
  147.      end;
  148.  
  149.  
  150. Function NCHANT(ch : char; n : integer; Bias : integer) : char;
  151.               {[STRING] Text Encryption - support for NCHANT }
  152. var x,xx  : integer;
  153.      begin
  154.      xx := (n + Bias) mod 95;
  155.      NCHANT := RollChar(ch,xx);
  156.      end;
  157.  
  158.  
  159. Function RVERT(ch : char; n : integer; Bias : integer) : char;
  160.               {[STRING] Reverse Text Encryption - support for RVERT }
  161. var x,xx  : integer;
  162.      begin
  163.      xx := (n + Bias) mod 95;
  164.      RVERT := RollChar(ch,-1*xx);
  165.      end;
  166.  
  167.  
  168.  
  169. Function  NCHANTstr(st : string) : string;
  170.               {[STRING] Text Encryption - grade 2, casual hackers }
  171. var i,n : integer;
  172.     s : string;
  173.     Bias : integer;
  174.      begin
  175.      n := length(st);
  176.      if not IsNCHANTed(st) then
  177.           begin { clear string }
  178.           Bias := trunc(random(31))+1;
  179.           s := st;
  180.           {writeln('Enchanting [',bias,'] [',s,']');}
  181.           for i := 1 to length(s) do s[i] := NCHANT(s[i],i,Bias);
  182.           NCHANTSTR := s + chr(128+bias);
  183.           end
  184.      else begin { already enchanted }
  185.           NCHANTSTR := st;
  186.           end;
  187.      end;
  188.  
  189.  
  190. Function  RVERTSTR(st : string) : string;
  191.               {[STRING] Reverse Enchantment - can be called with clear text }
  192. var i,n : integer;
  193.     s : string;
  194.     Bias : integer;
  195.      begin
  196.      RVERTSTR := st;
  197.      n := length(st);
  198.      if IsNCHANTed(st) then
  199.           begin { enchanted }
  200.           s := st;
  201.           Bias := ord(s[n])-128;
  202.           delete(s,n,1);
  203.           {writeln('Reverting  [',bias,'] [',s,']');}
  204.           for i := 1 to length(s) do s[i] := RVERT(s[i],i,Bias);
  205.           RVERTSTR := s;
  206.           end;
  207.      end;
  208.  
  209.  
  210.